﻿Option Explicit On
Module modOther

    Public cSection As New KeyValue
    Public cReg As New RegClass

    Public aFindItems As New ArrayList

    Public bAllowCodeColor As Boolean = True
    Public Const WM_USER = &H400
    Public Const EM_EXLINEFROMCHAR = WM_USER + 54

    'Public VersionString As String = "2." + CStr(CInt(My.Application.Info.Version.Revision / 7000)) + "." + CStr(CInt(My.Application.Info.Version.Revision / 75))
    Public VersionString As String = "2." + CStr(CInt(My.Application.Info.Version.Build / 750)) + "." + CStr(CInt(My.Application.Info.Version.Build / 15)) + "." + CStr(My.Application.Info.Version.Revision)

    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Integer
    Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As IntPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Int32) As Long

    Public Function GetSafeFileName(ByVal OrgName As String) As String
        Dim tmpArray As String() = OrgName.Split("\")
        Return tmpArray(UBound(tmpArray))
    End Function

    Public Sub CodeColors(ByVal Form As Form, ByVal Style As String, ByVal RichE As RichTextBox, ByVal RichE2 As RichTextBox)
        RichE2.Rtf = RichE.Rtf

        'Dim orgText As String = RichE2.Text
        Dim org0SStart As Integer = RichE.SelectionStart
        Dim orgFont As System.Drawing.Font = RichE2.SelectionFont
        Dim orgSStart As Integer = RichE2.SelectionStart
        Dim fntF As New FontFamily("微软雅黑")

        Dim CodeC1 As String() = {"#", "$", "(", ")", "*", ",", ".", "/", ":", "", "[", "]", "{", "}", "<", ">", "-", "=", "+", """", "@"}
        Dim CodeC2 As String() = {"and", "as", "case", "char", "Color.ass", "const", "downto", "else", "except", "finally", "for", "forward", "function", "if", "implementation", "interface", "is", "nil", "or", "private", "procedure", "public", "raise", "repeat", "string", "to", "try", "type", "unit", "uses", "var", "while", "external", "stdcall", "do", "until", "array", "of", "in", "shr", "shl", "cos", "div"}

        Dim re As String = ""

        For Each exp In CodeC2
            re = re + exp + "|"
        Next


        'CodeC1: array[0..20] of String = ("#","$","(",")","*",",",
        'CodeC2: array[0..44] of String = ("and","as","",
        Dim StartPos As Integer
        Dim OldCap As String
        Dim FontC, BackC, C1, C2, C3, strC, strC1 As Color

        RichE2.SelectAll()
        RichE2.SelectionFont = New Font(fntF, 10, FontStyle.Regular)
        RichE2.SelectionColor = FontC

        BackC = Color.White
        FontC = Color.Black
        C1 = Color.Teal
        C2 = Color.Maroon
        C3 = Color.Blue
        strC = Color.Maroon
        strC1 = Color.Silver

        OldCap = Form.Text     '保留原窗体的标题

        '对语法加亮的方案进行设置

        ''RichE2.SelectAll()
        'RichE2.color = BackC
        'RichE2.SelAttributes.color = FontC
        ''RichE2.SelectionColor = FontC
        'RichE2.DeselectAll()
        Dim rm As System.Text.RegularExpressions.MatchCollection
        Dim m As System.Text.RegularExpressions.Match

        rm = System.Text.RegularExpressions.Regex.Matches(LCase(RichE2.Text), re, System.Text.RegularExpressions.RegexOptions.Compiled)
        For Each m In rm
            RichE2.Select(m.Index, m.Length)
            RichE2.SelectionColor = Color.Blue
        Next


        StartPos = 0

        'RichE2.SelectionStart = 0     '结束高亮操作
        RichE2.SelectionStart = orgSStart
        RichE2.SelectionLength = 0

        RichE.Rtf = RichE2.Rtf
        RichE.SelectionStart = org0SStart
        RichE.SelectionLength = 0
    End Sub

    Private Sub CodeColors3(ByVal Form As Form, ByVal Style As String, ByVal RichE As RichTextBox, ByVal RichE2 As RichTextBox)
        RichE2.Rtf = RichE.Rtf


        Dim org0SStart As Integer = RichE.SelectionStart
        'Dim orgText As String = riche2.Text
        Dim orgFont As System.Drawing.Font = frmMain.rtfText.SelectionFont
        Dim orgSStart As Integer = RichE2.SelectionStart
        Dim fntF As New FontFamily("微软雅黑")

        Dim CodeC1 As String() = {"#", "$", "(", ")", "*", ",", ".", "/", ":", "", "[", "]", "{", "}", "<", ">", "-", "=", "+", """", "@"}
        Dim CodeC2 As String() = {"and", "as", "", "case", "char", "Color.ass", "const", "downto", "else", "", "except", "finally", "for", "forward", "function", "if", "implementation", "interface", "is", "nil", "or", "private", "procedure", "public", "raise", "repeat", "string", "to", "try", "type", "unit", "uses", "var", "while", "external", "stdcall", "do", "until", "array", "of", "in", "shr", "shl", "cos", "div"}
        'CodeC1: array[0..20] of String = ("#","$","(",")","*",",",
        'CodeC2: array[0..44] of String = ("and","as","",

        Dim StartPos As Integer
        Dim OldCap As String
        Dim FontC, BackC, C1, C2, C3, strC, strC1 As Color

        RichE2.SelectAll()
        RichE2.SelectionFont = New Font(fntF, 10, FontStyle.Regular)
        RichE2.SelectionColor = FontC

        BackC = Color.White
        FontC = Color.Black
        C1 = Color.Teal
        C2 = Color.Maroon
        C3 = Color.Blue
        strC = Color.Maroon
        strC1 = Color.Silver

        OldCap = Form.Text     '保留原窗体的标题

        With RichE2      '对Triche2dit控件进行设置
            If .WordWrap Then .WordWrap = False
            .SelectAll()
            '.SelAttributes.color = Color.Black
            .SelectionColor = Color.Black
            'SelAttributes.Style = []
            .SelectionStart = 0
        End With
        '对语法加亮的方案进行设置

        Dim rm As System.Text.RegularExpressions.MatchCollection
        Dim m As System.Text.RegularExpressions.Match
        Dim x As Integer ''lets remember where the text courser was before we mess with it 
        For Each pass In CodeC2
            x = RichE2.SelectionStart
            rm = System.Text.RegularExpressions.Regex.Matches(LCase(RichE2.Text), LCase(pass))
            For Each m In rm
                RichE2.Select(m.Index, m.Length)
                RichE2.SelectionColor = Color.Blue
            Next
            RichE2.Select(x, 0)
            RichE2.SelectionColor = Color.Black
        Next


        StartPos = 0
        'riche2.SelectionStart = 0     '结束高亮操作
        RichE2.SelectionStart = orgSStart
        RichE2.SelectionLength = 0

        RichE.Rtf = RichE2.Rtf
        RichE.SelectionStart = org0SStart
        RichE.SelectionLength = 0
    End Sub

    Private Sub CodeColorCurrentLine(ByVal Form As Form, ByVal Style As String, ByVal RichE As RichTextBox, ByVal RichE2 As RichTextBox)

        Dim org0SStart As Integer = RichE.SelectionStart
        'Dim orgText As String = riche.Text
        Dim CodeC2 As String() = {"and", "as", "case", "char", "Color.ass", "const", "downto", "else", "except", "finally", "for", "forward", "function", "if", "implementation", "interface", "is", "nil", "or", "private", "procedure", "private", "raise", "repeat", "string", "to", "try", "type", "unit", "uses", "var", "while", "external", "stdcall", "do", "until", "array", "of", "in", "shr", "shl", "cos", "div"}
        'CodeC1: array[0..20] of String = ("#","$","(",")","*",",",
        'CodeC2: array[0..44] of String = ("and","as","",
        Dim FoundAt As Long
        Dim StartPos, ToEnd, i As Integer
        Dim FontC, BackC, C1, C2, C3, strC, strC1 As Color
        BackC = Color.White
        FontC = Color.Black
        C1 = Color.Teal
        C2 = Color.Maroon
        C3 = Color.Blue
        strC = Color.Maroon
        strC1 = Color.Silver

        For i = 0 To UBound(CodeC2) '44      '对关键字进行语法加亮
            With RichE

                StartPos = RichE.SelectionStart - 5
                ToEnd = RichE.SelectionStart + 5 '.Text.Length
                FoundAt = .Find(CodeC2(i), StartPos, ToEnd, RichTextBoxFinds.WholeWord)
                'FoundAt = InStr(.Text, CodeC2(i), CompareMethod.Text)

                While FoundAt >= 0 And FoundAt + CodeC2(i).Length <> .Text.Length
                    .SelectionStart = FoundAt
                    .SelectionLength = CodeC2(i).Length
                    'SelAttributes.Color = C3
                    .SelectionColor = C3
                    StartPos = FoundAt + CodeC2(i).Length
                    FoundAt = .Find(CodeC2(i), StartPos, ToEnd, RichTextBoxFinds.WholeWord)
                    'FoundAt = InStr(.Text, CodeC2(i), CompareMethod.Text)
                    'Application.DoEvents()
                End While
            End With
        Next

        StartPos = 0

        RichE.SelectionStart = org0SStart
        RichE.SelectionLength = 0
        RichE.SelectionColor = Color.Black
    End Sub

End Module
